home *** CD-ROM | disk | FTP | other *** search
/ Amiga Game-Power / Amiga Game-Power.iso / power games ii / solitaire / lexikon / universal_lexikon (.txt) < prev    next >
AmigaBASIC Source Code  |  1994-05-20  |  8KB  |  350 lines
  1. ON ERROR GOTO fehler
  2. ini:
  3.   feld$(1)="Feld 1":la(1)=7
  4.   feld$(2)="Feld 2":la(2)=7
  5.   feld$(3)="Feld 3":la(3)=7
  6.   feld$(4)="Feld 4":la(4)=7
  7.   feld$(5)="Feld 5":la(5)=7
  8.   feld$(6)="Feld 6":la(6)=7
  9.   ein$="df0:"
  10.   DIM ein$(40)  
  11.   CHDIR ":lexikon"
  12.   SCREEN 2,640,350,4,2  
  13.   WINDOW 2,"",(0,0)-(631,200),0,2
  14.   PALETTE 2,1,0.13,0.8
  15.   PALETTE 3,0.6,0.8,0.53
  16.   PALETTE 4,0.93,0.2,0
  17.   PALETTE 5,1,1,0.13
  18.   PALETTE 6,0.73,0.73,0.73
  19.   PALETTE 7,1,0,0
  20.   PALETTE 8,1,1,0.13
  21.   CLS:GOSUB ueberschrift
  22.   COLOR 8:PRINT:PRINT
  23.   PRINT "Wenn Sie das Programm nutzen wollen, so legen Sie sich Bitte ein Direktory"
  24.   PRINT "mit dem Namen < Lexikon > an. Dort kopieren sie sich dann dieses Programm "
  25.   PRINT "hinein. Das Programm löscht alle info Datein von ihren Datein, so das Sie"
  26.   PRINT "Diese nachher nicht im Directory finden, wenn sie über die Workbench suchen"
  27.   PRINT :PRINT:COLOR 6
  28.   PRINT "Auch dieses Programm ist wieder vollständig Public Domain !"
  29.   PRINT "Ich bestehe lediglich darauf, das mein Name im Programm stehen bleibt."
  30.   COLOR 6:PRINT:PRINT
  31.   PRINT "Bei weiteren Fragen wenden Sie sich bitte an:"
  32.   PRINT:COLOR 8:PRINT SPC(30);"Martin Jochimczyk"
  33.   PRINT SPC(30);"Am Sande 12"
  34.   PRINT SPC(30);"2723 Scheeßel"
  35.   PRINT:PRINT:COLOR 3:PRINT SPC(20);"Bitte eine Taste drücken !"                
  36. a$="" 
  37. WHILE a$=""
  38. a$=INKEY$
  39. WEND
  40.   
  41.  
  42.  
  43. menue:
  44.   CLS:GOSUB ueberschrift
  45.   LINE (105,65)-(230,85),2,bf:LINE(104,64)-(231,86),3,b
  46.   COLOR 3,2:LOCATE 10,15:PRINT"DATEN EINGEBEN"
  47.   LINE (105,113)-(230,133),2,bf:LINE(104,112)-(231,134),3,b
  48.   LOCATE 16,20:PRINT"MASKE"
  49.   LINE (397,65)-(527,85),2,bf:LINE(396,64)-(527,86),3,b
  50.   LOCATE 10,53:PRINT"DATEN SUCHEN"
  51.   LINE (397,113)-(527,133),2,bf:LINE(396,112)-(527,134),3,b
  52.   LOCATE 16,54:PRINT"VERLASSEN"
  53.   LINE (105,160)-(230,182),2,bf:LINE(104,159)-(231,183),3,b
  54.   LOCATE 22,18:PRINT"EINTRÄGE"
  55.   LINE (397,160)-(527,182),2,bf:LINE(396,159)-(528,183),3,b
  56.   LOCATE 22,52:PRINT"DATEN  LÖSCHEN"
  57.   COLOR 1,0
  58. Maus:
  59.   ON MOUSE GOSUB Start
  60.    MOUSE ON
  61.   GOTO Maus
  62. Start:
  63.   Maus=MOUSE(0)
  64.   y=MOUSE(2):x=MOUSE(1)
  65.   IF x>396 AND x<527 AND y>112 AND y<134 THEN programmende
  66.   IF x>396 AND x<527 AND y>64 AND y<86 THEN datensuchen
  67.   IF x>104 AND x<231 AND y>112 AND y<134 THEN maske
  68.   IF x>104 AND x<231 AND y>64 AND y<86 THEN dateneingeben
  69.   IF x>104 AND x<231 AND y>159 AND y<183 THEN direkt
  70.   IF x>396 AND x<527 AND y>159 AND y<183 THEN datenloeschen
  71.   RETURN
  72. programmende:
  73.   CLS:GOSUB ueberschrift
  74.   schrift$="Wirklich verlassen ?":GOSUB janeinabfrage
  75. maus1:
  76.   ON MOUSE GOSUB start1
  77.    MOUSE ON
  78.   GOTO maus1
  79. start1:
  80.   maus1=MOUSE(0)
  81.   y=MOUSE(2):x=MOUSE(1)
  82.   IF x>225 AND x<255 AND y>85 AND y<98 THEN ende
  83.   IF x>385 AND x<430 AND y>85 AND y<98 THEN menue 
  84.   RETURN
  85. ende:
  86.   CLS
  87.   COLOR 2:LOCATE 12,30:PRINT "Auf Wiedersehen ..."
  88.   FOR e=1 TO 1500:NEXT
  89.   SYSTEM
  90. dateneingeben:
  91.   CLS:GOSUB ueberschrift 
  92.   schrift$="DATEI EINGEBEN":schrift1$="MENÜ"
  93.   GOSUB linienzeichnen 
  94. eingabe:
  95.   COLOR 1,0
  96.   LOCATE 5,27:PRINT SPACE$(20)
  97.   LOCATE 5,2:LINE INPUT"Bitte Suchpfad eingeben: ";such$ 
  98.   IF such$="" THEN GOTO menue
  99.   OPEN such$ FOR OUTPUT AS #1
  100.   GOSUB feldabfrage
  101.   COLOR 7
  102.   FOR i=1 TO 6
  103.    LOCATE 8+2*i,3+la(i):LINE INPUT "";f$(i)
  104.   NEXT
  105.   FOR i=1 TO 6
  106.    WRITE #1,f$(i)
  107.   NEXT
  108.    KILL such$+".info"
  109.   CLOSE #1
  110. maus2:
  111.   ON MOUSE GOSUB start2
  112.    MOUSE ON
  113.   GOTO maus2
  114. start2:
  115.   maus2=MOUSE(0)
  116.   y=MOUSE(2):x=MOUSE(1)
  117.   IF x>396 AND x<527 AND y>169 AND y<189 THEN eingabe
  118.   IF x>105 AND x<230 AND y>169 AND y<189 THEN menue
  119.   RETURN
  120. datensuchen:
  121.   CLS
  122.   GOSUB ueberschrift 
  123.   schrift$="DATEI SUCHEN":GOSUB kleinlinienzeichnen 
  124.   LINE (65,169)-(190,189),2,bf:LINE(64,168)-(191,190),3,b
  125.   LOCATE 23,15:PRINT"MENÜ"
  126.   LINE(245,169)-(355,189),2,bf:LINE(244,168)-(356,190),3,b
  127.   LOCATE 23,35:PRINT"DRUCKEN"
  128. eingabe1:
  129.   GOSUB feldloeschen 
  130.   LOCATE 5,2:LINE INPUT"Bitte Suchpfad eingeben: ";such$ 
  131.   IF such$="" THEN GOTO menue
  132.   OPEN "i",#1,such$
  133.   GOSUB feldabfrage 
  134.   COLOR 7
  135.   FOR i=1 TO 6
  136.    INPUT #1,f$(i)
  137.   NEXT
  138.   FOR i=1 TO 6
  139.    LOCATE 8+2*i,3+la(i):PRINT f$(i)
  140.   NEXT
  141.   CLOSE #1 
  142. maus3:
  143.   ON MOUSE GOSUB start3
  144.    MOUSE ON
  145.   GOTO maus3
  146. start3:
  147.   maus3=MOUSE(0)
  148.   y=MOUSE(2):x=MOUSE(1)
  149.   IF x>430 AND x<560 AND y>169 AND y<189 THEN eingabe1
  150.   IF x>64 AND x<191 AND y>169 AND y<189 THEN menue
  151.   IF x>244 AND x<355 AND y>169 AND y<189 THEN druckenfrage:
  152.   RETURN
  153. druckenfrage:
  154.   CLS:GOSUB ueberschrift 
  155.   schrift$="Feldbezeichnungen mitdrucken ?"
  156.   GOSUB janeinabfrage
  157. maus4:
  158.   ON MOUSE GOSUB start4
  159.    MOUSE ON
  160.   GOTO maus4
  161. start4:
  162.   maus4=MOUSE(0)
  163.   y=MOUSE(2):x=MOUSE(1)
  164.   IF x>225 AND x<255 AND y>85 AND y<98 THEN vordruck
  165.   IF x>385 AND x<430 AND y>85 AND y<98 THEN drucken
  166.   RETURN
  167. vordruck: 
  168.   FOR i=1 TO 6
  169.    LPRINT feld$(i)+CHR$(58)+CHR$(32);f$(i)
  170.   NEXT i
  171.   LPRINT CHR$(10):LPRINT CHR$(10)
  172.   GOTO datensuchen 
  173. drucken:
  174.   FOR i=1 TO 6
  175.    LPRINT f$(i)
  176.   NEXT i
  177.   LPRINT CHR$(10):LPRINT CHR$(10)
  178.   GOTO datensuchen 
  179.  direkt:
  180.   CLS:GOSUB ueberschrift 
  181.   schrift$="Dateispezifikation ?"
  182.   GOSUB janeinabfrage
  183. maus5:
  184.   ON MOUSE GOSUB start5
  185.    MOUSE ON
  186.   GOTO maus5
  187. start5:
  188.   maus5=MOUSE(0)
  189.   y=MOUSE(2):x=MOUSE(1)
  190.   IF x>225 AND x<255 AND y>85 AND y<98 THEN pfadaendern
  191.   IF x>385 AND x<430 AND y>85 AND y<98 THEN fensterloeschen 
  192.   RETURN
  193. pfadaendern:
  194.   COLOR 5:LOCATE 14,31:PRINT"Bitte Prefix eingeben:"
  195.   LINE (225,125)-(430,139),6,b
  196.   COLOR 3
  197.   LOCATE 17,31:LINE INPUT"";ein$
  198.   CHDIR ein$
  199.   GOTO fensterloeschen
  200. fensterloeschen:
  201.   LINE (100,40)-(530,160),0,bf 
  202.   GOTO diskinhalt 
  203. diskinhalt:
  204.   WINDOW 3,"",(40,40)-(591,180),0,2
  205.   LOCATE 5,2:COLOR 6
  206.   FILES   
  207.   COLOR 3
  208. maus6:
  209.   LOCATE 10,24:PRINT"Bitte linke Maustaste !"
  210.   IF MOUSE(0)>-1 THEN maus6
  211.   CHDIR "df0:lexikon"
  212.   WINDOW CLOSE 3
  213.   GOTO menue 
  214. maske:
  215.   CLS
  216.   GOSUB ueberschrift 
  217.   schrift$="MASKE LADEN":GOSUB kleinlinienzeichnen 
  218.   LINE (65,169)-(195,189),2,bf:LINE(64,168)-(196,190),3,b
  219.   LOCATE 23,10:PRINT"MASKE SPEICHERN"
  220.   LINE(245,169)-(355,189),2,bf:LINE(244,168)-(356,190),3,b
  221.   LOCATE 23,36:PRINT"MENÜ"
  222.   COLOR 1,0
  223.   FOR i=1 TO 6 
  224.    LOCATE 6+2*i,5:PRINT i".Feldbezeichnung:"
  225.   NEXT i
  226.   COLOR 4
  227.   FOR i=1 TO 6
  228.    LOCATE 6+2*i,27:LINE INPUT feld$(i)
  229.   IF feld$(1)="" THEN feld1$(1)="Feld 1":GOTO maus7
  230.   NEXT
  231.   FOR i=1 TO 6
  232.    la(i)=LEN(feld$(i))+1
  233.   NEXT
  234. maus7:
  235.   ON MOUSE GOSUB Start7
  236.    MOUSE ON
  237.   GOTO maus7
  238. Start7:
  239.   maus7=MOUSE(0)
  240.   y=MOUSE(2):x=MOUSE(1)
  241.   IF x>430 AND x<560 AND y>169 AND y<189 THEN maskeladen
  242.   IF x>64 AND x<195 AND y>169 AND y<189 THEN maskespeichern 
  243.   IF x>244 AND x<355 AND y>169 AND y<189 THEN menue
  244.   RETURN
  245. maskespeichern:
  246.   CLS:GOSUB  ueberschrift:GOSUB feldloeschen 
  247.   LOCATE 5,2:LINE INPUT"Bitte Maskennamen eingeben: ";maskna$ 
  248.   IF maskna$="" THEN GOTO menue
  249.   OPEN maskna$ FOR OUTPUT AS #1 
  250.   FOR i=1 TO 6
  251.    WRITE #1,feld$(i),la(i)
  252.   NEXT
  253.   CLOSE #1
  254.   KILL maskna$+".info"
  255.   GOTO menue 
  256. maskeladen:                 
  257.   CLS:GOSUB  ueberschrift:GOSUB feldloeschen 
  258.   LOCATE 5,2:LINE INPUT"Bitte Maskennamen eingeben: ";maskna$ 
  259.   IF maskna$="" THEN GOTO menue
  260.   OPEN "i",#1,maskna$
  261.   FOR i=1 TO 6
  262.    INPUT #1,feld$(i),la(i)
  263.   NEXT
  264.   CLOSE #1
  265.   GOTO menue 
  266. datenloeschen:
  267.   CLS:GOSUB ueberschrift  
  268.   schrift$="DATEN LÖSCHEN":schrift1$="MENÜ"
  269.   GOSUB linienzeichnen 
  270.   COLOR 1,0
  271. maus8:
  272.   ON MOUSE GOSUB Start8
  273.    MOUSE ON
  274.   GOTO maus8
  275. Start8:
  276.   maus8=MOUSE(0)
  277.   y=MOUSE(2):x=MOUSE(1)
  278.   IF x>396 AND x<527 AND y>169 AND y<189 THEN eingabe2
  279.   IF x>105 AND x<230 AND y>169 AND y<189 THEN menue  
  280.   RETURN
  281. eingabe2: 
  282.   GOSUB feldloeschen 
  283.   LINE (115,45)-(525,155),0,bf
  284.   LOCATE 5,2:LINE INPUT"Bitte Dateinamen eingeben: ";datnam$ 
  285.   IF datnam$="" THEN GOTO menue
  286.   schrift$="Datei wirklich löschen ?" 
  287.   GOSUB janeinabfrage 
  288. maus9:
  289.   ON MOUSE GOSUB Start9
  290.    MOUSE ON
  291.   GOTO maus9
  292. Start9:
  293.   maus9=MOUSE(0)
  294.   y=MOUSE(2):x=MOUSE(1)
  295.   IF x>225 AND x<255 AND y>85 AND y<98 THEN killen
  296.   IF x>385 AND x<430 AND y>85 AND y<98 THEN eingabe2   
  297.   RETURN
  298. killen:
  299.   KILL datnam$
  300.   COLOR 1
  301.   LOCATE 5,2:PRINT SPACE$(70)
  302.   LINE (115,45)-(525,155),0,bf
  303.   GOTO maus8
  304. fehler:
  305.   IF ERR=53 THEN PRINT "Datei nicht vorhanden !"
  306.   FOR i=1 TO 1500:NEXT
  307.   RUN 
  308. ueberschrift: 
  309.   COLOR 4
  310.   LOCATE 2,8:PRINT"Universallexikon Version 1.0  -- geschrieben von Martin Jochimczyk"
  311.   COLOR 1
  312.   LINE (0,20)-(632,20),1 
  313.   RETURN
  314. feldabfrage: 
  315.   COLOR 6
  316.   LOCATE 10,2:PRINT STRING$(70,95);:COLOR 5:LOCATE 10,2:PRINT feld$(1)+CHR$(58);  
  317.   COLOR 6
  318.   LOCATE 12,2:PRINT STRING$(70,95);:COLOR 5:LOCATE 12,2:PRINT feld$(2)+CHR$(58);
  319.   COLOR 6
  320.   LOCATE 14,2:PRINT STRING$(70,95);:COLOR 5:LOCATE 14,2:PRINT feld$(3)+CHR$(58);
  321.   COLOR 6
  322.   LOCATE 16,2:PRINT STRING$(70,95);:COLOR 5:LOCATE 16,2:PRINT feld$(4)+CHR$(58);
  323.   COLOR 6
  324.   LOCATE 18,2:PRINT STRING$(70,95);:COLOR 5:LOCATE 18,2:PRINT feld$(5)+CHR$(58);
  325.   COLOR 6
  326.   LOCATE 20,2:PRINT STRING$(70,95);:COLOR 5:LOCATE 20,2:PRINT feld$(6)+CHR$(58);
  327.   RETURN 
  328. janeinabfrage:
  329.   LINE (120,50)-(520,150),6,b
  330.   COLOR 5:LOCATE 8,25:PRINT schrift$
  331.   COLOR 7:LOCATE 12,30:PRINT"JA":LOCATE 12,50:PRINT"NEIN" 
  332.   LINE (225,85)-(255,98),6,b
  333.   LINE (385,85)-(430,98),6,b
  334.   RETURN 
  335. linienzeichnen:
  336.   LINE (397,169)-(527,189),2,bf:LINE(396,168)-(527,190),3,b
  337.   COLOR 3,2:LOCATE 23,52:PRINT schrift$
  338.   LINE (105,169)-(230,189),2,bf:LINE(104,168)-(231,190),3,b
  339.   LOCATE 23,20:PRINT schrift1$
  340.   RETURN
  341. kleinlinienzeichnen:
  342.   LINE (430,169)-(560,189),2,bf:LINE(429,168)-(561,190),3,b
  343.   COLOR 3,2:LOCATE 23,57:PRINT schrift$
  344.   RETURN
  345. feldloeschen:
  346.   COLOR 1,0
  347.   LOCATE 5,27:PRINT SPACE$(20)
  348.   RETURN
  349.     
  350.